home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt32s1.arc / KFIXFNAM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-10-02  |  2.5 KB  |  72 lines
  1. (*----------------------------------------------------------------------*)
  2. (*    Fix_File_Name --- Fix file name from remote to be MS DOS style    *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. FUNCTION Fix_File_Name( FileName : AnyStr ) : AnyStr;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Fix_File_Name                                        *)
  10. (*                                                                      *)
  11. (*     Purpose:    Fixes received file name to be MS DOS style          *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Fixed_Name := Fix_File_Name( FileName : AnyStr ) : AnyStr;    *)
  16. (*                                                                      *)
  17. (*           FileName  --- name of file from remote system              *)
  18. (*                                                                      *)
  19. (*----------------------------------------------------------------------*)
  20.  
  21. VAR
  22.    Temp_Name : AnyStr;
  23.    Suffix    : STRING[3];
  24.    I         : INTEGER;
  25.    Dot_Found : BOOLEAN;
  26.    Done      : BOOLEAN;
  27.  
  28. BEGIN (* Fix_File_Name *)
  29.  
  30.    Suffix    := '';
  31.    Temp_Name := '';
  32.    Dot_Found := FALSE;
  33.    Done      := FALSE;
  34.    I         := LENGTH( FileName );
  35.  
  36.    REPEAT
  37.  
  38.       CASE Dot_Found OF
  39.  
  40.          TRUE:  BEGIN
  41.                    IF FileName[I] <> '.' THEN
  42.                       Temp_Name := UpCase( FileName[I] ) + Temp_Name;
  43.                 END;
  44.  
  45.          FALSE: IF FileName[I] = '.' THEN
  46.                    BEGIN
  47.                       Dot_Found := TRUE;
  48.                       IF ( LENGTH( Temp_Name ) <= 3 ) THEN
  49.                          Suffix := Temp_Name
  50.                       ELSE
  51.                          Suffix := COPY( Temp_Name, 1, 3 );
  52.                       Temp_Name := '';
  53.                    END
  54.                 ELSE
  55.                    Temp_Name := UpCase( FileName[I] ) + Temp_Name;
  56.  
  57.       END (* CASE *);
  58.  
  59.       I    := I - 1;
  60.       Done := Done OR ( I < 1 );
  61.  
  62.    UNTIL Done;
  63.  
  64.    IF ( LENGTH( Temp_Name ) > 8 ) THEN
  65.       Temp_Name := COPY( Temp_Name, 1, 8 );
  66.  
  67.    IF Dot_Found THEN
  68.       Temp_Name := Temp_Name + '.' + Suffix;
  69.  
  70.    Fix_File_Name := Temp_Name;
  71.  
  72. END   (* Fix_File_Name *);